Obesity by City

Column

Final plot

Column

Version 1

Version 2

Version 3

Version 4

Obesity x Heart Disease

Column

Final plot

Column

Version 1

Version 2

---
title: "Data Viz Final Project"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    social: menu
    source_code: embed
---

```{r setup, include=FALSE}
library(flexdashboard)
library(tidyverse)
library(rio)
library(colorblindr)
library(janitor)
library(magrittr)
library(ggrepel)
library(fontawesome)
```


```{r import data}
data_raw <- import("http://bchi.bigcitieshealth.org/rails/active_storage/blobs/eyJfcmFpbHMiOnsibWVzc2FnZSI6IkJBaHBGdz09IiwiZXhwIjpudWxsLCJwdXIiOiJibG9iX2lkIn19--c6b5c30fbd8b79859797e1dc260a06064c8f3864/Current%20BCHI%20Platform%20Dataset%20(7-18)%20-%20Updated%20BCHI%20Platform%20Dataset%20-%20BCHI,%20Phase%20I%20&%20II.csv?disposition=attachment")

# wrangle data
data_filt <- data_raw %>% 
  clean_names() %>% 
  select(shortened_indicator_name, year, sex, race_ethnicity, value, place) %>% 
  filter(shortened_indicator_name %in% c("Adult Physical Activity Levels", "Teen Physical Activity Levels", "Adult Binge Drinking","Adult Obesity","Heart Disease Mortality Rate","Bike Score","Walkability","Median Household Income","Race/Ethnicity","Death Rate (Overall)")) %>% 
  mutate(value = as.numeric(value)) %>% 
  mutate_at(c("sex", "race_ethnicity", "place"), factor) %>% 
 mutate(place = plyr::mapvalues(x = .$place, from = c("Fort Worth (Tarrant County), TX", "Indianapolis (Marion County), IN", "Las Vegas (Clark County), NV", "Miami (Miami-Dade County), FL", "Oakland (Alameda County), CA", "Portland (Multnomah County), OR"), to = c("Fort Worth, TX", "Indianapolis, IN", "Las Vegas, NV", "Miami, FL", "Oakland, CA", "Portland, OR"))) %>% 
  na.omit()
```


# Obesity by City {data-icon="fa-map-marker-alt"}


```{r}
# wrangle data
data_obesity <- data_filt %>% 
  filter(shortened_indicator_name == "Adult Obesity") %>% 
  spread(shortened_indicator_name, value) %>% 
  group_by(place) %>% 
  summarise(avg_obesity = mean(`Adult Obesity`, na.rm = TRUE),
            se_obesity = sundry::se(`Adult Obesity`))
```
 

Column {data-width=650}
-----------------------------------------------------------------------

### Final plot

```{r}
data_obesity %>% 
  mutate(compare_us_tot = ifelse(
    avg_obesity > .$avg_obesity[which(data_obesity$place == "U.S. Total")], "above",
    ifelse(avg_obesity < .$avg_obesity[which(data_obesity$place == "U.S. Total")], "below", "avg"))) %>% 
  ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) + 
  geom_col(aes(fill = compare_us_tot), alpha = 0.8) +
  coord_flip() +
  scale_y_continuous(labels = scales::percent_format(scale = 1)) + 
  scale_fill_manual(values = c("#BA4A00", "black", "#ABCFF7")) +
  labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL, caption = "States above the U.S. average are colored red. States below the U.S. average are colored green.") + 
  theme_minimal() + 
  geom_hline(yintercept = data_obesity$avg_obesity[which(data_obesity$place == "U.S. Total")], linetype = 2) + 
  theme(legend.position = "none")

```

Column {.tabset data-width=350}
-----------------------------------------------------------------------

### Version 1

```{r}
data_obesity %>% 
  ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) + 
  geom_col() +
  coord_flip()
```

### Version 2

```{r}
data_obesity %>% 
  ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) + 
  geom_col() + 
  coord_flip() +
  scale_y_continuous(labels = scales::percent_format(scale = 1)) + 
  labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL) + 
  theme_minimal()
```

### Version 3

```{r}
data_obesity %>% 
  mutate(compare_us_tot = ifelse(
    avg_obesity > .$avg_obesity[which(data_obesity$place == "U.S. Total")], "above",
    ifelse(avg_obesity < .$avg_obesity[which(data_obesity$place == "U.S. Total")], "below", "avg"))) %>% 
  ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) + 
  geom_segment(aes(color = compare_us_tot, x = fct_reorder(place, avg_obesity), xend = place, y=0, yend = avg_obesity), size = 1, alpha = 0.7) +
  geom_point(aes(color = compare_us_tot), size = 3, alpha = 0.7) +
  coord_flip() +
  scale_y_continuous(labels = scales::percent_format(scale = 1)) + 
  scale_color_manual(values = c("#BA4A00", "black", "#ABCFF7")) +
  labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL, caption = "States above the U.S. average are colored red. States below the U.S. average are colored green.") + 
  theme_minimal() + 
  geom_hline(yintercept = data_obesity$avg_obesity[which(data_obesity$place == "U.S. Total")], linetype = 2) + 
  theme(legend.position = "none")
```

### Version 4

```{r}
data_obesity %>% 
  mutate(compare_us_tot = ifelse(
    avg_obesity > .$avg_obesity[which(data_obesity$place == "U.S. Total")], "above",
    ifelse(avg_obesity < .$avg_obesity[which(data_obesity$place == "U.S. Total")], "below", "avg"))) %>% 
  ggplot(aes(fct_reorder(place, avg_obesity), avg_obesity)) + 
  geom_errorbar(aes(ymin = avg_obesity - 1.96*se_obesity,
                    ymax = avg_obesity + 1.96*se_obesity),
                    color = "gray40") +
  geom_point(aes(color = compare_us_tot), size = 4, alpha = 0.7) +
  coord_flip() +
  scale_y_continuous(labels = scales::percent_format(scale = 1)) + 
  scale_color_manual(values = c("#BA4A00", "black", "#ABCFF7")) +
  labs(title = "Percent of Adults Who Are Obese", y = "Percent", x = NULL, caption = "States above the U.S. average are colored red. States below the U.S. average are colored green.") + 
  theme_minimal() + 
  geom_hline(yintercept = data_obesity$avg_obesity[which(data_obesity$place == "U.S. Total")], linetype = 2) + 
  theme(legend.position = "none")
```


# Obesity x Heart Disease {data-icon="fa-heartbeat"}

```{r}
# wrangle data
obesity_hdmr <- data_filt %>%
  filter(shortened_indicator_name %in% c("Adult Obesity", "Heart Disease Mortality Rate"),
         sex == "Both",
         race_ethnicity == "All",
         place != "U.S. Total") %>%
  mutate(i = row_number()) %>%
  spread(shortened_indicator_name, value) %>%
  group_by(place) %>%
  summarize(avg_obesity =  mean(`Adult Obesity`, na.rm = TRUE),
            avg_hdmr = mean(`Heart Disease Mortality Rate`, na.rm = TRUE))
```

Column {data-width=650}
-----------------------------------------------------------------------

### Final plot

```{r}
## 3 most obese cities
top_3_obese <- obesity_hdmr %>% 
  top_n(3, avg_obesity)

## 3 least obese cities
bottom_3_obese <- obesity_hdmr %>% 
  top_n(-3, avg_obesity)

obesity_hdmr %>% 
  ggplot(aes(avg_obesity, avg_hdmr)) + 
  geom_point(size = 5, alpha = 0.7, color = "gray70") +
  geom_point(data = top_3_obese, size = 5, color = "#BA4A00") +
  geom_point(data = bottom_3_obese, size = 5, color = "#ABCFF7") +
  geom_smooth(method = "lm", alpha = 0.2, color = "gray60") +
  geom_text_repel(data = top_3_obese, aes(label = place), min.segment.length = 0) +
  geom_text_repel(data = bottom_3_obese, aes(label = place), min.segment.length = 0) +
  theme_minimal() + 
  scale_x_continuous(labels = scales::percent_format(scale = 1)) + 
  labs(x = "Percent Obese", y = "Heart Disease Mortality Rate", title = "Relationship between Obesity and Heart Disease", subtitle = "State labels represent 3 most/least obese states", caption = "3 most/least obese states are colored red/green, respectively. \n Heart Disease Mortality Rate is age-adjusted per 100,000 people.")
```


Column {.tabset data-width=350}
-----------------------------------------------------------------------

### Version 1

```{r}
obesity_hdmr %>% 
  ggplot(aes(avg_obesity, avg_hdmr)) + 
  geom_point() +
  geom_smooth(method = "lm")
```

### Version 2

```{r}
obesity_hdmr %>% 
  ggplot(aes(avg_obesity, avg_hdmr)) + 
  geom_point() +
  geom_smooth(method = "lm") +
  geom_text_repel(aes(label = place)) + 
  theme_minimal()
```

# Opioid-related Deaths {data-icon="fa-pills"}

```{r}
# wrangle data
data_opioid <- data_raw %>% 
  clean_names() %>% 
  select(shortened_indicator_name, year, sex, race_ethnicity, value, place) %>% 
  filter(shortened_indicator_name %in% c("Opioid-Related Overdose Mortality Rate")) %>% 
  mutate(value = as.numeric(value)) %>% 
  mutate_at(c("sex", "race_ethnicity", "place"), factor) %>% 
  na.omit()

# identify city with highest opioid-related overdose mortality rate from 2010 to 2016
top_opioid = data_opioid %>% 
  filter(sex == "Both",
         race_ethnicity == "All",
         place != "U.S. Total",
         year %in% 2010:2016) %>% 
  unique() %>% 
  spread(shortened_indicator_name, value) %>% 
  group_by(place) %>% 
  summarize(mean_opioid = mean(`Opioid-Related Overdose Mortality Rate`, na.rm = TRUE)) %>% 
  top_n(1) %>% 
  select(place)
```

Column {data-width=650}
-----------------------------------------------------------------------

### Final plot

```{r}
data_opioid %>% 
  filter(sex != "Both", 
         race_ethnicity == "All",
         place == top_opioid$place,
         year %in% 2010:2016) %>% 
  spread(shortened_indicator_name, value) %>% 
  ggplot(aes(year, `Opioid-Related Overdose Mortality Rate`, color= sex)) + 
  geom_line(size= 2) +
  geom_point(size = 4) + 
  labs(x = NULL, y = "Opioid-Related Overdose Mortality Rate", title = "Opioid-use Related Mortality Rates Over Time", subtitle = "Colombus, OH", caption = "Rates are age-adjusted per 100,000 people.") + 
  theme_minimal() + 
  scale_color_OkabeIto() +
  theme(legend.position = "none") +
  geom_label(data = data_opioid %>% 
  filter(sex != "Both", 
         race_ethnicity == "All",
         place == top_opioid$place,
         year == 2016) %>% 
         spread(shortened_indicator_name, value), 
         aes(y =`Opioid-Related Overdose Mortality Rate`, label = sex),
         nudge_x = -0.7,
         size = 5) 
```

Column {.tabset data-width=350}
-----------------------------------------------------------------------

### Version 1

```{r}
data_opioid %>% 
  filter(sex != "Both", 
         race_ethnicity == "All",
         place == top_opioid$place,
         year %in% 2010:2016) %>% 
  spread(shortened_indicator_name, value) %>% 
  ggplot(aes(year, `Opioid-Related Overdose Mortality Rate`, color= sex)) + 
  geom_line() 
```


### Version 2

```{r}
data_opioid %>% 
  filter(sex != "Both", 
         race_ethnicity == "All",
         place == top_opioid$place,
         year %in% 2010:2016) %>% 
  spread(shortened_indicator_name, value) %>% 
  ggplot(aes(year, `Opioid-Related Overdose Mortality Rate`, color= sex)) + 
  geom_line(size= 2) +
  geom_point(size = 4) + 
  labs(x = NULL, y = "Opioid-Related Overdose Mortality Rate", title = "Opioid-use Related Mortality Rates Over Time", subtitle = "Colombus, OH", caption = "Rates are age-adjusted per 100,000 people.") + 
  theme_minimal() 
```